home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / macros0.em < prev    next >
Encoding:
Text File  |  1992-10-07  |  2.3 KB  |  87 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;   EuLisp Module  -   Copyright (C) Codemist and University of Bath 1990   ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. ;;
  8.  
  9. ;; Change Log:
  10. ;;   Version 1.0 
  11.  
  12. ;;
  13.  
  14. (defmodule macros0
  15.  
  16.   (ccc lists list-operators others arith) ()
  17.  
  18.   ;; The compiler syntax is a little different...
  19.   
  20.   (deflocal *defs-compile-time* ())
  21.  
  22.   (defun compile-time-p ()
  23.     *defs-compile-time*)
  24.  
  25.   ((setter setter) compile-time-p
  26.    (lambda (x) (setq *defs-compile-time* x)))
  27.   
  28.   (export compile-time-p)
  29.  
  30.   ;; Control Extentions - Conditional Extentions
  31.   (defmacro cond b
  32.     (if b (if (cdr (car b)) (list 'if (car (car b)) (cons 'progn (cdr (car b)))
  33.                   (cons 'cond (cdr b)))
  34.         (list 'or (car (car b)) (cons 'cond (cdr b))))
  35.       ()))
  36.  
  37.   ;; Control Extentions - Binding extentions
  38.   ;; LET expands to LAMBDA
  39.   (defmacro let (bind . body)
  40.     (cons (cons 'lambda (cons (\@letvars bind) body)) (\@letforms bind)))
  41.  
  42.   (defun \@letvars (b)
  43.     (if b (cons (car (car b)) (\@letvars (cdr b)))
  44.       ()))
  45.  
  46.   (defun \@letforms (b)
  47.     (if b (cons (car (cdr (car b))) (\@letforms (cdr b)))
  48.       ()))
  49.  
  50.   ;; LET* expands to LET
  51.   (defmacro let* (bind . body)
  52.     (if bind (list 'let (cons (car bind) ())
  53.            (cons 'let* (cons (cdr bind) body)))
  54.       (cons 'progn body)))
  55.  
  56.   ;; LABELS is a complex LET
  57.   (defmacro labels (binds . body)
  58.     (cons 'let (cons (\@labelsvar binds) (\@labelsbody binds body))))
  59.  
  60.   (defun \@labelsvar (b)
  61.     (if b (cons (list (car (car b)) ()) (\@labelsvar (cdr b)))
  62.       ()))
  63.  
  64.   (defun \@labelsbody (b body)
  65.     (if b (cons (list 'setq (car (car b)) (cons 'lambda (cdr (car b))))
  66.             (\@labelsbody (cdr b) body))
  67.       body))
  68.  
  69.   (defmacro and b
  70.     (if b (if (cdr b) (list 'if (car b) (cons 'and (cdr b)) ())
  71.         (car b))
  72.       t))
  73.  
  74.   (defmacro or b
  75.     (if b 
  76.        (if (cdr b) (list 'let (list (list '\@ (car b))) 
  77.               (list 'if '\@ '\@ (cons 'or (cdr b))))
  78.       (car b))
  79.       ()))
  80.  
  81.   (defmacro when (pred . forms) `(if ,pred (progn ,@forms) nil))
  82.   (defmacro unless (pred . forms) `(if ,pred nil (progn ,@forms)))
  83.  
  84.   (export let let* cond and or when unless labels) 
  85.  
  86. )
  87.